package cld_server;

use English;
use Socket;
# use Net::TCP::Server;
use Digest::MD5 qw(md5_hex);
use Crypt::Blowfish;
use Crypt::CBC;
use POSIX qw(:errno_h :fcntl_h);
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);

$cld_server::last_error=undef;
$cld_server::last_rc=0;

#########################################################################
# Firstly create a new object. This expects a hash with the following	#
# elements:								#
# PORT		- The port to listen on.				#
# KEY		- The key to use to decode/encode packets.		#
#########################################################################

sub new {
my $proto=shift;
my $class=ref($proto) || $proto;
my %args=@_;
my $self={};
my $lh;

	$cld_server::last_error="";
	$cld_server::last_rc=0;
	if(!exists($args{PORT}) || ! exists($args{KEY})) {
		$cld_server::last_error="Missing mandatory arguments";
		$cld_server::last_rc=1;
		return undef;
	}

	#################################################################
	# Now create the listener object...				#
	#################################################################

	my $p = getprotobyname('tcp');
	if(!socket($lh,PF_INET,SOCK_STREAM,$p)) {
		$cld_server::last_error="Unable to create 'tcp' socket: $!";
		$cld_server::last_rc=2;
		return(undef);
	}
	
	if(!setsockopt($lh,SOL_SOCKET, SO_REUSEADDR,pack("l", 1))) {
		$cld_server::last_error="Unable to set socket options: $!";
		$cld_server::last_rc=3;
		return(undef);
	}
	if(!bind($lh,sockaddr_in($args{PORT}, INADDR_ANY))) {
		$cld_server::last_error="Unable to bind to socket: $!";
		$cld_server::last_rc=3;
		return(undef);
	}
	
	if(!listen($lh,SOMAXCONN)) {
		$cld_server::last_error="Unable to set maximum socket connections: $!";
		return(undef);
	}

	#################################################################
	# Store the details of the object and return it...		#
	#################################################################

	$self->{PORT}=$args{PORT};
	$self->{SOCKET}=$lh;
	$self->{KEY}=$args{KEY};
	$self->{CRYPT}=Crypt::CBC->new($args{KEY},"Blowfish");
	$self->{NEW_SOCKET}=undef;
	$self->{FLAGS}=fcntl($lh,F_GETFL,0);
	$self->{OFLAGS}=$self->{FLAGS};

	bless($self,$class);
	return $self;
}

#########################################################################
# This will return the socket this object uses - which is useful	#
# when the user wishes to use it for select() calls.			#
#########################################################################

sub socket {
my $self=shift;
	return $self->{SOCKET};
}

#########################################################################
# The accept method is used by the server to wait and accept a client	#
# connection. The server can of course ensure traps are set to 		#
# act accordingly.							#
# No arguments are required - though it does return a handle to the 	#
# new socket handling this connection, or undef if there is a problem.	#
#########################################################################

sub accept {
my $self=shift;
my ($sh,$new_fd);

	my $paddr=accept($sh,$self->{SOCKET});
	if(! defined($paddr)) {
		if($! == EWOULDBLOCK) {
			$cld_server::last_error="No client waiting for connection";
			$cld_server::last_rc=100;
		} else {
			$cld_server::last_error="Error waiting for client connection";
			$cld_server::last_rc=3;
		}
		return undef;
	}

	#################################################################
	# We now turn on autoflush for this handle.			#
	#################################################################

	$new_fd=select($sh);
	$|=1;
	select($new_fd);

	#################################################################
	# Store the details of the socket handler and also return it.	#
	#################################################################

	$self->{NEW_SOCKET}=$sh;
	return $sh;
}

#########################################################################
# The routine below will read a line from the client connection and	#
# will decode it and return the decoded message or undef if it is	#
# not decoded correctly.						#
# NO ARGUMENTS ARE REQUIRED.						#
#########################################################################

sub decode_msg {
my $self=shift;
my ($md52,$msg,$sh);
my ($md5,$msg_to_decode,$plain_text);

	$sh=$self->{NEW_SOCKET};
	$msg=<$sh>;
	if(! defined($msg)) {
		$cld_server::last_error="Broken socket before client request completed.";
		$cld_server::last_rc=4;
		return undef;
	}
	chomp($msg);
	($md5,$msg_to_decode)=($msg =~ /([A-Fa-f0-9]+),(.*)/);
	if(!defined($md5) || !defined($msg_to_decode)) {
		$cld_server::last_error="Invalid message format.";
		$cld_server::last_rc=5;
		return undef;
	}

	$plain_text=$self->{CRYPT}->decrypt_hex($msg_to_decode);
	if(!defined($plain_text)) {
		$cld_server::last_error="Invalid message format.";
		$cld_server::last_rc=6;
		return undef;
	}
	$md52=md5_hex($plain_text);
	if($md52 ne $md5) {
		$cld_server::last_error="Invalid encryption key used for message.";
		$cld_server::last_rc=7;
		return undef;
	}
	return $plain_text;
}

#########################################################################
# Now the opposite routine which is responisble for taking a message	#
# and encoding it and sending it to the client. 			#
# Argument is MSG - text for message.					#
# Will return 0 if OK, 1 if error.					#
#########################################################################

sub encode_msg {
my $self=shift;
my %args=@_;
my ($md5,$encoded_msg);
my $sock;

	if(!exists($args{MSG})) {
		$cld_server::last_error="Missing mandatory arguments";
		$cld_server::last_rc=1;
		return 1;
	}
	$sock=$self->{NEW_SOCKET};
	$md5=md5_hex($args{MSG});
	$encoded_msg=$self->{CRYPT}->encrypt_hex($args{MSG});
	if(!(print $sock "$md5,$encoded_msg\n")) {
		$cld_server::last_error="Unable to write message to client socket";
		$cld_server::last_rc=8;
		return 1;
	}
	return 0;
}

#########################################################################
# Now a method to return the error string and error code of the last	#
# message, if any.							#
#########################################################################

sub get_error {
	return ($cld_server::last_error,$cld_server::last_rc);
}

#########################################################################
# Now a method to close the client session.				#
#########################################################################

sub close_session {
my $self=shift;

	close($self->{NEW_SOCKET});
	$self->{NEW_SOCKET}=undef;
}

sub close_server {
my $self=shift;

	if(defined($self->{NEW_SOCKET})) {
		close($self->{NEW_SOCKET});
	}
	close($self->{SOCKET});
}

sub non_block {
my $self=shift;
my $f;

	$f=$self->{FLAGS};
	$self->{FLAGS}=fcntl($self->{SOCKET},F_SETFL,$f|O_NONBLOCK);
}

sub block {
my $self=shift;
my $f;
	$f=$self->{OFLAGS};
	$self->{FLAGS}=fcntl($self->{SOCKET},F_SETFL,$f);
}

1;

